home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / iguana / incosrc / incosrc.exe / MIRRBALL / PATH / PATH.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-18  |  6KB  |  252 lines
  1.  
  2. USES Matrix;
  3.  
  4. FUNCTION POW2(a : DOUBLE): DOUBLE;
  5.   BEGIN
  6.      POW2 := a*a
  7.   END;
  8.  
  9. FUNCTION POW3(a : DOUBLE): DOUBLE;
  10.   BEGIN
  11.      POW3 := a*a*a
  12.   END;
  13.  
  14. FUNCTION TAN(a : DOUBLE): DOUBLE;
  15.   BEGIN
  16.      TAN := Sin(a)/Cos(a)
  17.   END;
  18.  
  19.   { --------------------------------- }
  20.  
  21.  
  22. TYPE
  23.    Pt = RECORD
  24.       f, t, slope : DOUBLE;
  25.       a, b, c, d  : DOUBLE
  26.    END;
  27.  
  28.    PtArray = RECORD
  29.       npts : INTEGER;
  30.       pts  : ARRAY [1..200] OF Pt;
  31.    END;
  32.  
  33.  
  34. PROCEDURE CalcSlopes(VAR pa: PtArray);
  35.   VAR
  36.      i : INTEGER;
  37.   BEGIN
  38.      FOR i := 1 TO pa.npts DO BEGIN
  39.         IF i = 1 THEN
  40.            pa.pts[i].slope := (pa.pts[i+1].f-pa.pts[i].f) /
  41.                           (pa.pts[i+1].t-pa.pts[i].t)
  42.         ELSE IF i = pa.npts THEN
  43.            pa.pts[i].slope := (pa.pts[i].f-pa.pts[i-1].f) /
  44.                           (pa.pts[i].t-pa.pts[i-1].t)
  45.         ELSE
  46.             pa.pts[i].slope := TAN(
  47.                  (ARCTAN((pa.pts[i+1].f-pa.pts[i].f) /
  48.                          (pa.pts[i+1].t-pa.pts[i].t)) +
  49.                   ARCTAN((pa.pts[i].f-pa.pts[i-1].f) /
  50.                          (pa.pts[i].t-pa.pts[i-1].t)))/2);
  51.  
  52.  
  53. {           pa.pts[i].slope := (pa.pts[i+1].f-pa.pts[i-1].f) /
  54.                           (pa.pts[i+1].t-pa.pts[i-1].t);
  55. }        WriteLn('Pendiente calculada: ', pa.pts[i].slope);
  56.      END
  57.   END;
  58.  
  59.  
  60. PROCEDURE CalcCoeffs(VAR pa: PtArray);
  61.   VAR
  62.      i      : INTEGER;
  63.      ma, m1 : Matrix4x4;
  64.      da, d1 : DOUBLE;
  65.      b      : Column4;
  66.   BEGIN
  67.      CalcSlopes(pa);
  68.      ma[4,1] := 1;
  69.      ma[4,2] := 1;
  70.      ma[3,3] := 1;
  71.      ma[3,4] := 1;
  72.      ma[4,3] := 0;
  73.      ma[4,4] := 0;
  74.      FOR i := 1 TO pa.npts-1 DO BEGIN
  75.         b[1] := pa.pts[i].f;
  76.         b[2] := pa.pts[i+1].f;
  77.         b[3] := pa.pts[i].slope;
  78.         b[4] := pa.pts[i+1].slope;
  79.         ma[3,1] := pa.pts[i].t;
  80.         ma[3,2] := pa.pts[i+1].t;
  81.         ma[2,3] := pa.pts[i].t*2;
  82.         ma[2,4] := pa.pts[i+1].t*2;
  83.         ma[2,1] := POW2(pa.pts[i].t);
  84.         ma[2,2] := POW2(pa.pts[i+1].t);
  85.         ma[1,3] := POW2(pa.pts[i].t)*3;
  86.         ma[1,4] := POW2(pa.pts[i+1].t)*3;
  87.         ma[1,1] := POW3(pa.pts[i].t);
  88.         ma[1,2] := POW3(pa.pts[i+1].t);
  89.         da := Determinante4(ma);
  90.  
  91.         PrepareMatrix(m1, ma, b, 1);
  92.         d1 := Determinante4(m1);
  93.         pa.pts[i].a := d1/da;
  94.  
  95.         PrepareMatrix(m1, ma, b, 2);
  96.         d1 := Determinante4(m1);
  97.         pa.pts[i].b := d1/da;
  98.  
  99.         PrepareMatrix(m1, ma, b, 3);
  100.         d1 := Determinante4(m1);
  101.         pa.pts[i].c := d1/da;
  102.  
  103.         PrepareMatrix(m1, ma, b, 4);
  104.         d1 := Determinante4(m1);
  105.         pa.pts[i].d := d1/da;
  106.         WriteLn('Calculados coeficientes del segmento ',i, ',')
  107.      END;
  108.   END;
  109.  
  110.  
  111.  
  112.  
  113.   { ----------------------------------- }
  114.  
  115. FUNCTION Interpolate(VAR pf: PtArray; x : DOUBLE): DOUBLE;
  116.   VAR
  117.      i : INTEGER;
  118.  
  119.   BEGIN
  120.      Interpolate := 0;
  121.      FOR i := 2 TO pf.npts-2 DO
  122.         IF (x >= pf.pts[i].t) AND (x <= pf.pts[i+1].t) THEN
  123.            Interpolate := pf.pts[i].a*POW3(x) +
  124.                           pf.pts[i].b*POW2(x) +
  125.                           pf.pts[i].c*     x  +
  126.                           pf.pts[i].d
  127.  
  128.   END;
  129.  
  130.   { ----------------------------------- }
  131.  
  132. VAR
  133.    PF1, PF2 : PtArray;
  134.  
  135. PROCEDURE ReadPtList(VAR fi: TEXT);
  136.   VAR
  137.      i         : INTEGER;
  138.      t, f1, f2 : DOUBLE;
  139.   BEGIN
  140.      i := 1;
  141.      WHILE (i <= 200) AND NOT Eof(fi) DO BEGIN
  142.         t := -1;
  143.         ReadLn(fi, t, f1, f2);
  144.         IF t < 0 THEN BEGIN
  145.            PF1.npts := i-1;
  146.            PF2.npts := i-1;
  147.            EXIT
  148.         END;
  149.         PF1.pts[i].t := t;
  150.         PF2.pts[i].t := t;
  151.         PF1.pts[i].f := f1;
  152.         PF2.pts[i].f := f2;
  153.         WriteLn('Leido...');
  154.         INC(i)
  155.      END;
  156.      PF1.npts := i-1;
  157.      PF2.npts := i-1
  158.   END;
  159.  
  160. { ----------------------------------- }
  161.  
  162. TYPE
  163.    TScr = ARRAY[0..199,0..319] OF BYTE;
  164.  
  165. VAR
  166.    Screen : TScr ABSOLUTE $A000:0;
  167.  
  168.  
  169. PROCEDURE Usage;
  170.   BEGIN
  171.      WriteLn('Cubic Spline Generator v0.5, (C) 1993 bye Jare/Iguana');
  172.      WriteLn('   Usage: PATH nsteps [infile]');
  173.      HALT
  174.   END;
  175.  
  176. VAR
  177.   i  : INTEGER;
  178.   fi : TEXT;
  179.   t, x, y : DOUBLE;
  180.  
  181.   NFrames : INTEGER;
  182.  
  183. CONST
  184.   MI : Matrix4x4 = ((1.0, 2.0, 3.0, 4.0),
  185.                     (5.0, 9.0, 8.0, 7.0),
  186.                     (3.0, 2.0, 1.0, 9.0),
  187.                     (4.0, 2.0, 6.0, 7.0));
  188.  
  189. BEGIN
  190.    IF (ParamCount < 1) OR (ParamCount > 2) THEN
  191.       Usage;
  192.    VAL(ParamStr(1), NFrames, i);
  193.    IF i <> 0 THEN
  194.       Usage;
  195.    IF ParamCount = 2 THEN BEGIN
  196.       Assign(fi, ParamStr(2));
  197.       Reset(fi);
  198.       ReadPtList(fi);
  199.       Close(fi)
  200.    END ELSE
  201.       ReadPtList(input);
  202.  
  203.  
  204.    WriteLn('Prueba.... |I| = ', Determinante4(MI));
  205.  
  206.    WriteLn(' Número de puntos : ', PF1.npts);
  207.    WriteLn('-------------------------');
  208.    FOR i := 1 TO PF1.npts DO
  209.       WriteLn(PF1.pts[i].t:10, PF2.pts[i].t:10, ' |  ',
  210.               PF1.pts[i].f:10, PF2.pts[i].f:10);
  211.  
  212.  
  213.  
  214.    CalcCoeffs(PF1);
  215.    CalcCoeffs(PF2);
  216.  
  217.    ASM
  218.       MOV       AX,0
  219.       INT       16h
  220.       MOV       AX,13h
  221.       INT       10h
  222.    END;
  223.  
  224.    FOR i := 0 TO NFrames-1 DO BEGIN
  225.       t := i*(PF1.pts[PF1.npts-1].t - PF1.pts[2].t)/NFrames +
  226.            PF1.pts[2].t;
  227.       x := Interpolate(PF1,t);
  228.       y := Interpolate(PF2,t);
  229.       Screen[ROUND(t), ROUND(x)] := 12;
  230.       Screen[ROUND(t), ROUND(y)] := 13;
  231.       Screen[ROUND(y), ROUND(x)] := 15
  232.    END;
  233.  
  234.    FOR i := 2 TO PF1.npts-1 DO BEGIN
  235.       y := PF1.pts[i].t;
  236.       x := PF1.pts[i].f;
  237.       Screen[ROUND(y), ROUND(x)] := 14;
  238.       x := PF2.pts[i].f;
  239.       Screen[ROUND(y), ROUND(x)] := 14
  240.    END;
  241.  
  242.  
  243.  
  244.  
  245.    ASM
  246.       MOV       AX,0
  247.       INT       16h
  248.       MOV       AX,3
  249.       INT       10h
  250.    END;
  251. END.
  252.